Developer CD Series 1995 February: Tool Chest/Dev.CD Feb 95/Dev.CD Feb 95.toast/Sample Code/Pascal Sample 3.0B10/Source/TrafficLights.p

Text File | 1993-10-13 | 27.6 KB | 663 lines | [TEXT/MPS ]

(******************************************************************************
*
*    Apple Macintosh Developer Technical Support
*
*    Interfaces for the traffic light code
*
*    Program:    Sample 3.0
*    FILE:        TrafficLights.p - Pascal implementation
*
*    by:            Matt Deatherage
*
*    Copyright © 1988-1993 Apple Computer, Inc.
*    All rights reserved.
*
*******************************************************************************
*
* This is the biggest of the units in Sample 3.0 -- the unit that handles
* all the documents, the circles, the traffic lights, the drawing to the
* screen (including color, multiple monitors, DeviceLoop and more).  This
* code saves files to disk, reads files from disk, reads and writes the
* preferences file, handles balloon help for our windows, creates and
* destroys all windows, and more.
*
* Originally, I intended all of the "application-specific" stuff to be in
* this unit -- anything that would have to change if you were changing
* Sample's documents to be something other than traffic lights would be
* in this unit.  To a large degree I met that goal, but in some places it
* would have added extra layers of indirection that, in the end, I felt
* weren't necessary.  You'll see some empty procedures in here because the
* "shell" functions in Sample.p call them (for example, RemoveAppAEHandlers,
* which is supposed to remove any Apple event handlers that are application-
* specific, but we don't have any).
*
* This unit defines two primary data types.  The "CircleRec" is a record
* containing everything needed to define a circle -- its rectangle, font,
* text, text style, size and the color of the circle.  The "document" is
* a structure that includes an array of CircleRec records, plus a count
* of how many circles are really there, which one is the active one, and
* other document-specific data like a print record, a dirty flag, a reference
* number for open files and a FileLikeSpec to point to the file on disk.
* (FileLikeSpec records are defined in SampleUtilities.p.)
*
* Since this is Pascal, and we have to declare a size for a record, we
* have a kMaxCircles constant (10) -- there are always ten circle records in
* a document, even if the preferences specify a maximum of zero.  The prefs
* just let the user limit what actions can be performed.  It would be cool
* to have the document record just contain pointers to circle records, and
* then we could have a maximum of several dozen without taking as much space
* as one circle record -- but that wouldn't be much help unless we also added
* the ability to resize the window and/or scroll it.
*
* Another good change would be to have the document for each window, which
* is attached via the window's refCon field, as a handle instead of a pointer.
* Right now, all documents are created with NewPtr and never move.  We manage
* memory well enough that this doesn't cause fragmentation, and we know that
* each document's size does not change after it is created, so this actually
* works OK for us, but many applications will need more flexible document
* sizes and will need to use resizeable handles, keeping them unlocked except
* when in use to reduce memory fragmentation.
*
******************************************************************************)

UNIT TrafficLights; { unit to deal with the traffic lights in Sample }

INTERFACE

(*******************************************************************************
* Used Units
*******************************************************************************)

USES Traps, Types, Errors, Resources, ToolUtils, Fonts, Files, Finder, Folders,
     QDOffScreen, Balloons, Picker, PrintTraps, StandardFile, AppleTalk,
     Processes, PPCToolbox, EPPC, Notification, AppleEvents, Features,
     SampleUtilities;

(*******************************************************************************
* Constants
*******************************************************************************)

CONST

    { Constants dealing with defaults }

    kMaxCircles = 10;            { For static arrays, there has to be a limit }
    kDefaultNum = 3;            { Default number of circles per document }
    rWindow = 128;                 { The 'WIND' resource we use }

    rDefaultFonts = 1000;         { 'STR#' resource ID with default font names }
    rDefaultStrings = 1001;     { 'STR#' resource ID with default circle texts }
    rDefaultSizes = 1000;         { 'DfSz' resource with default text sizes }
    rDefaultColorID = 1000;     { 'RGB ' resource with default color }

    { Constants for alerts for errors we might encounter }

    rNoMemForWindow = 2000;             { No memory for new window or document }
    rReallyRevert = 2010;                 { Alert asking if it's OK to revert }
    rNoMemoryForOperation = 2011;        { No memory to do that operation }

    { Constants having to do with the preferences file }

    rPrefsFileName = 128;                 { 'STR ' resource containing the
                                          preferences file name }
    kSamplePrefsType = 'Pref';             { file type of our preferences file }
    kSamplePrefsRsrc = 'Pref';            { res type of the prefs resource in it }
    rSamplePrefsID = 128;                 { our preference resource ID }

    { Constants for the files we save }

    kOurCreatorType = 'DSp1';             { OSType for our creator type }
    kOurDocumentType = 'DSp1';            { file type for our documents --
                                          p for Pascal, which came first }
    kFileInternalVersion = $0001;         { internal version number for our file
                                          format; we can't read files if the
                                          version inside is bigger than this
                                          value }
    rMiscStrings = 1004;                { Miscellaneous strings }
    kSaveFileAs = 1;                    { "Save current document as:" }
    kPickColor = 2;                        { "Select a color for this circle." }

    { Options for the dirty flag for documents }

    kDocumentDirty = 1;                    { Document needs saving to disk }
    kDocumentNew = 2;                     { Document is new -- enable save but
                                          don't prompt to save when closing }
    kDocumentClean = 3;                    { Document is saved to disk }

    kActiveCircleBalloonString = 43;    { Balloon help string for active circle }
    kInactiveCircleBalloonString = 44;    { Balloon help string for inactive one }
    rBalloonHelpStringID = 5000;        { 'STR#' with most balloon help strings }

    { Constants for memory cushions and safeguards }

    kDialogMemorySize = 16 * 1024;         { We require this much memory available
                                          in our heap to do the modify circle or
                                          preferences dialogs, realistically }
    kMemoryCushionSize = 16 * 1024;     { To keep breathing room in our heap,
                                          we won't open a new window unless this
                                          much space is available in our heap. }

    { Constants defining TrafficLight-specific menus.  Menus start with "m"
      and items start with "i". }

    mCircle = 131;
    iAdd = 1;
    iModify = 2;
    iDelete = 3;

(*******************************************************************************
* Types
*******************************************************************************)

TYPE

(*******************************************************************************
* Each circle record contains all the visual aspects of a traffic light we
* might want to draw.
*******************************************************************************)

    CircleRec = RECORD
        circleRect: Rect;                 { The rectangle for the circle
                                          (and FrameOval) }
        circleFont: Str255;             { font family name for this circle's
                                          font }
        circleText: Str255;             { string to display in this circle }
        circleFace: Style;                 { Style for text in circle }
        circleTxSize: INTEGER;             { Size for text in circle }
        circleColor: RGBColor;            { color of circle's background }
        END;
    CircleRecPtr = ^CircleRec;

(*******************************************************************************
* The document record contains a bunch of circles plus other information
* necessary to keep with each document.
*******************************************************************************)

    document = RECORD
        numCircles: INTEGER;            { how many circles in this document? }
        activeCircle: INTEGER;            { which one is the active one? }
        printRecord: THPrint;            { the document's print record -- always
                                          keep one with a document so the user's
                                          Page Setup choices aren't lost }
        dirtyFlag: INTEGER;                { Is this document written to disk? }
        circleInset: INTEGER;            { How much to inset a circle }
        ourFileRefNum: INTEGER;            { refNum of file if open, or zero if
                                          this isn't an open file }
        ourFile: FileLikeSpec;            { FSSpec describing file on disk }
        circleArray: ARRAY [1..kMaxCircles] OF CircleRec;
                                        { all the circles in this document }
        END;
    DocumentPtr = ^document;

(*******************************************************************************
* The Preferences record describes all the user-editable preferences.  It might
* have been easier to keep three global variables, but having this record
* allows us to write generic preference-manipulating routines that take or
* return records as parameters.
*******************************************************************************)

    Preferences = RECORD
        maxNumCircles: INTEGER;            { how many circles can we allow in this
                                          document? }
        circleRectSize: INTEGER;        { Rectangle for default document circles }
        circleInsetSize: INTEGER;        { Inset for default document circles }
        END;

(*******************************************************************************
* The LightConditions record keeps track of three state variables for each
* circle record, and is used as a container to pass to light-drawing functions.
* If the light is "on", that means it's the one that currently has the black
* frame, the colored background and the text is showing -- unless it's not
* "active", in which case you see the frame and the text but nothing else.
* If a light is not on and not active, you see nothing.  We also note if
* this light is being printed so we can do things differently while printing
* if necessary (like not erasing rectangles, or being careful about non-
* rectangular clipping regions for PostScript printers).
*******************************************************************************)

    LightConditions = RECORD
        itsOn: BOOLEAN;                    { is this light the current one? }
        itsActive: BOOLEAN;                { is it in an active window? }
        arePrinting: BOOLEAN;            { are we printing? }
        theCircle: CircleRecPtr;        { which light are we talking about? }
        END;
    LightConditionsPtr = ^LightConditions;

(*******************************************************************************
* Global variables maintained by this unit
*******************************************************************************)

VAR

    gPrefsRecord: Preferences;             { our preferences for this session }

(*******************************************************************************
*
* AddDefaultCircle - add a new circle to a document.
*
* This routine gets a new default circle (using defaults in the resource fork)
* and adds it to the window, resizing it as required to show the new circle.
*
*******************************************************************************)

PROCEDURE AddDefaultCircle(theDoc: DocumentPtr; theWindow: WindowPtr);

(*******************************************************************************
*
* GetDocumentDrawingSize - determine the area of this document.
*
* This routine examines a document structure and fills in a Point whose .h
* member has the width of this document, in pixels, and whose .v member has
* the height.
*
*******************************************************************************)

PROCEDURE GetDocumentDrawingSize(theDoc: DocumentPtr; VAR theSize: Point);

(*******************************************************************************
*
* DeleteActiveCircle - remove a circle from a window.
*
* This routine, called in response to the "Delete Circle" menu item, removes
* the currently active circle from the window's document, resizes the window
* and invalidates it.  The new active circle is the previous circle.
*
*******************************************************************************)

PROCEDURE DeleteActiveCircle(theWindow: WindowPtr);

(*******************************************************************************
*
* RemoveAppAEHandlers - deinstall any application-specific Apple Event handlers.
*
*******************************************************************************)

PROCEDURE RemoveAppAEHandlers;

(*******************************************************************************
*
* InstallAppAEHandlers - install any application-specific Apple Event handlers.
*
*******************************************************************************)

PROCEDURE InstallAppAEHandlers;

(*******************************************************************************
*
* InitializeApplication - perform application-specific startup tasks
*
* This routine performs initialization tasks specific to our application.
* in this particular case, we get the preferences from disk, initialize
* the window count to zero and use the Segment Loader functions to open any
* files that the user may have double-clicked on in a system without the
* Apple Event Manager.  Returns TRUE if we started up just fine.
*
*******************************************************************************)

FUNCTION InitializeApplication: BOOLEAN;

(*******************************************************************************
*
* TerminateApplication - perform application-specific teardown tasks
*
* This routine performs any application-specific teardown tasks, releasing
* memory, etc.  If we can't quit at this point for some reason, this routine
* must return FALSE.
*
*******************************************************************************)

FUNCTION TerminateApplication: BOOLEAN;

(*******************************************************************************
*
* DrawWindow - draw a given window's document into a given GrafPort
*
* This routine fetches a window's document and draws it into the window. If
* the supplied drawingPort parameter is not NIL, we draw into that GrafPort
* instead, which can be handy for printing and other redirections.  The
* "printing" BOOLEAN is TRUE if we're printing; the isActive parameter is TRUE
* if this should be drawn as if it were an active window.
*
*******************************************************************************)

PROCEDURE DrawWindow(window: WindowPtr; drawingPort: GrafPtr; printing: BOOLEAN;
                     isActive: BOOLEAN);

(*******************************************************************************
*
* ChangeCircleColor - ask the user for a new circle color
*
* This routine calls the Macintosh Color Picker to present the color choice
* dialog on the user's deepest screen, storing the user's color choice in
* the circle record if the user confirms the dialog.
*
* Don't call this routine if Color QuickDraw isn't installed.
*
*******************************************************************************)

PROCEDURE ChangeCircleColor(theCircle: CircleRecPtr);

(*******************************************************************************
*
* ChangeCircleFont - replace a circle record's font
*
* This setter function changes a circle record to contain a new font name.
*
*******************************************************************************)

PROCEDURE ChangeCircleFont(theCircle: CircleRecPtr; theNewFontName: Str255);

(*******************************************************************************
*
* ChangeCircleTxSize - replace a circle record's text size
*
* This setter function changes a circle record to contain a new font size.
*
*******************************************************************************)

PROCEDURE ChangeCircleTxSize(theCircle: CircleRecPtr; theNewSize: INTEGER);

(*******************************************************************************
*
* ChangeCircleText - replace a circle record's text string
*
* This setter function changes a circle record to contain a new string.
*
*******************************************************************************)

PROCEDURE ChangeCircleText(theCircle: CircleRecPtr; theNewText: Str255);

(*******************************************************************************
*
* ChangeCircleStyle - replace a circle record's text style
*
* This setter function changes a circle record to contain a new font style.
*
*******************************************************************************)

PROCEDURE ChangeCircleStyle(theCircle: CircleRecPtr; theNewStyle: Style);

(*******************************************************************************
*
* GetDocumentDirtyFlag - return a document's dirty flag
*
* This getter function returns a document's dirty flag, so external routines
* don't have to peek directly into document structures.
*
*******************************************************************************)

FUNCTION GetDocumentDirtyFlag(theDoc: DocumentPtr): INTEGER;

(*******************************************************************************
*
* SetDocumentDirtyFlag - sets a document's dirty flag
*
* This setter function sets a document's dirty flag, so external routines
* don't have to poke directly into document structures.
*
*******************************************************************************)

PROCEDURE SetDocumentDirtyFlag(theDoc: DocumentPtr; theFlag: INTEGER);

(*******************************************************************************
*
* InvalidateCircle - invalidate's a circle's rectangle
*
* This routine invalidates the rectangle for a circle in the current GrafPort,
* hopefully making it be redrawn on the next update event.
*
*******************************************************************************)

PROCEDURE InvalidateCircle(theCircle: CircleRecPtr);

(*******************************************************************************
*
* DrawDocument - draw a document structure into a given GrafPort
*
* DrawDocument draws a document (not a window) into a given GrafPort, and can
* be called by functions to draw windows, print, make pictures or anything
* else that needs an image of a document structure.  printing is TRUE if the
* drawing routines should act as if they're printing; isActive is TRUE if the
* document should be drawn as if it were an active window.
*
*******************************************************************************)

PROCEDURE DrawDocument(theDoc: DocumentPtr; drawingPort: GrafPtr; printing,
                       isActive: BOOLEAN);

(*******************************************************************************
*
* DrawLight - draw a single light
*
* DrawLight does the real work -- it takes a LightConditions record describing
* how a CircleRec should appear and draws it, using color on color systems,
* optimizing depth on multiple monitors and adjusting the color of the text
* string so it's white if on a dark background, and black if on a light
* background.  If there is no color, active circles are always white text
* on a black background.
*
*******************************************************************************)

PROCEDURE DrawLight(myLight: LightConditions);

(*******************************************************************************
*
* CloseAppWindow - close a document window
*
* Called by Sample.p when it needs to close a window belonging to the program,
* this routine checks the dirty flag of the window's document and prompts
* for saving if the document is dirty, saving the file to disk if the user
* wants it saved.  action is either kClosing or kQuitting.  CloseAppWindow
* returns TRUE if the window was succesfully closed and its structures
* disposed safely.
*
*******************************************************************************)

FUNCTION CloseAppWindow(theWindow: WindowPtr; action: INTEGER): BOOLEAN;

(*******************************************************************************
*
* PutPrefsToFile - write a preferences record to an open file on disk
*
* This routine writes the preferences record thePrefs to the open file whose
* reference number is theRefNum.
*
*******************************************************************************)

PROCEDURE PutPrefsToFile(thePrefs: preferences; theRefNum: INTEGER);

(*******************************************************************************
*
* MakeWindowFromDoc - Create a window for a document structure
*
* MakeWindowFromDoc creates a window and changes its parameters to fit the
* document whose pointer is the only parameter.
*
*******************************************************************************)

FUNCTION MakeWindowFromDoc(theDoc: DocumentPtr): WindowPtr;

(*******************************************************************************
*
* MakeDocumentPicture - Create a PICT with a document's image in it
*
* This routine creates a QuickDraw Picture that, when drawn, reproduces a
* document as if the document were drawn in an active window.
*
*******************************************************************************)

FUNCTION MakeDocumentPicture(theDoc: DocumentPtr): PicHandle;

(*******************************************************************************
*
* DoContentClick - Handle mouseDown events in document windows
*
* Sample.p calls this routine when there's a mouse down in the content Region
* of a document window.  DoContentClick changes the active light to the one
* clicked on if different than the current active light, and presents the
* "Modify Circle" dialog if that circle was double-clicked.
*
*******************************************************************************)

PROCEDURE DoContentClick(window: WindowPtr; event: EventRecord);

(*******************************************************************************
*
* DoHelp - Handle balloon help
*
* If the mouse is over the frontmost window and there's a mouse-moved event
* and balloon help is on, Sample.p calls DoHelp to present the new balloon
* for the new mouse location, and to calculate a new mouseMoved Region (the
* second parameter) so that we get called again if we need to change balloons.
*
*******************************************************************************)

PROCEDURE DoHelp(where: Point; mouseRgn: RgnHandle);

(*******************************************************************************
*
* DoNew - Create a new untitled window
*
* DoNew creates a new, default document and a window that draws it, returning
* the window pointer.
*
*******************************************************************************)

FUNCTION DoNew: WindowPtr;

(*******************************************************************************
*
* DoPageSetup - present the Page Setup dialog for a window's print record
*
* This routine extracts the window's document's print record and conducts
* the standard style dialog with the user (if possible).  It's provided as
* a shell to the Print unit's PageSetup routine so that anyone wanting
* to do this with a given window doesn't have to dig into the document
* structure to get the print record.
*
*******************************************************************************)

FUNCTION DoPageSetup(theWindow: WindowPtr): BOOLEAN;

(*******************************************************************************
*
* DoPrint - print a document window
*
* This routine extracts the window's document's print record and conducts
* the standard job dialog with the user (if possible), printing the window's
* contents if the user confirmed or if the job dialog couldn't be done.
* It's provided as a shell to the Print unit's Print routine so that anyone
* wanting to do this with a given window doesn't have to dig into the document
* structure to get the print record.
*
*******************************************************************************)

FUNCTION DoPrint(theWindow: WindowPtr): BOOLEAN;

(*******************************************************************************
*
* DoPrintFile - print a document on disk without opening a window for it
*
* This routine handles the expected Apple Event 'pdoc' behavior -- it fetches
* a document from disk and prints it but doesn't open a window for it.
*
*******************************************************************************)

PROCEDURE DoPrintFile(theFile: FileLikeSpecPtr; theMergePrintRecord: THPrint);

(*******************************************************************************
*
* DoSave - save a document to disk
*
* This routine saves a document to disk.  If it's not already part of an open
* file, it prompts for a place to save using the Standard File Package.  If
* all goes well, the return value is TRUE and the window's title is changed to
* reflect the saved document's name.
*
*******************************************************************************)

FUNCTION DoSave(theWindow: WindowPtr): BOOLEAN;

(*******************************************************************************
*
* DoSaveAs - save a document to disk, always prompting for location
*
* This routine saves a document to disk.  It prompts for a place to save using
* the Standard File Package.  If all goes well, the return value is TRUE and the
* window's title is changed to reflect the saved document's name.  In addition,
* any old file that this document came from is closed.  If there's an error,
* the original file (if any) remains open.
*
*******************************************************************************)

FUNCTION DoSaveAs(theWindow: WindowPtr): BOOLEAN;

(*******************************************************************************
*
* DoRevert - restore a document to its last state saved to disk
*
* DoRevert asks the user if he really wants to discard any changes to the file
* he's made since it was last saved, and if he confirms, it closes the file
* and refetches the document from the original file, redrawing the window.
* It returns TRUE if no errors happened while doing this, whether the user
* confirmed the revert operation or not.
*
*******************************************************************************)

FUNCTION DoRevert(theWindow: WindowPtr): BOOLEAN;

(*******************************************************************************
*
* DoOpenDocument - Create a window for a document from disk
*
* This routine reads a document from disk and creates a new window representing
* it.  If the parameter is not NIL, it's interpreted as a FileLikeSpecPtr
* describing the file to open.  If it is NIL, DoOpenDocument prompts the
* use with Standard File to select a file to open.
*
*******************************************************************************)

FUNCTION DoOpenDocument(theFileSpec: FileLikeSpecPtr): WindowPtr;

(*******************************************************************************
*
* GetDocumentFromFile - make a document structure from a disk file
*
* This routine reads a file from disk and constructs a document structure from
* it.  Like DoOpenDocument, if theFile is NIL, it calls Standard File to ask
* which file to read from disk.  It returns TRUE if the document was succesfully
* constructed from the disk file.
*
*******************************************************************************)

FUNCTION GetDocumentFromFile(theFile: FileLikeSpecPtr;
                             theDoc: DocumentPtr): BOOLEAN;

(*******************************************************************************
*
* MakeEmptyDoc - Create a standard, default document structure based on
*                 preferences and the defaults in our resource fork
*
*******************************************************************************)

FUNCTION MakeEmptyDoc: DocumentPtr;

(*******************************************************************************
*
* ChangeCircleOptions - conduct the "Modify Circle" dialog.
*
* If enough memory is available and it's OK to interact with the user, this
* routine calls DoCircleOptions in the SampleDialog unit to present the
* loverly "Modify Circle" modal dialog, returning TRUE if the user confirmed
* changes to the circle.
*
*******************************************************************************)

FUNCTION ChangeCircleOptions(VAR circle: CircleRec): BOOLEAN;

IMPLEMENTATION

{$I TrafficLights.inc1.p}

END. { unit TrafficLights }